home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / bcpl / bcplib / bcplroot next >
Encoding:
Text File  |  1994-01-10  |  37.4 KB  |  1,126 lines
  1.           Globsize = 0
  2.  
  3.           Start = 1 << 2
  4.  
  5.           HostProc = 2 << 2
  6.  
  7.           StartInit = 3 << 2
  8.  
  9.           Stacksize = 4 << 2
  10.  
  11.           BrkEsc = 5 << 2
  12.  
  13.           Instring = 8 << 2
  14.  
  15.           Outstring= 9 <<2
  16.  
  17.           Result2 = 13 << 2
  18.  
  19.           LineBuff = 17 << 2
  20.  
  21.           Input = 27 <<2
  22.  
  23.           Cis = 31 << 2
  24.  
  25.           Cos = 32 << 2
  26.  
  27.           ReturnCode = 39 << 2
  28.  
  29.           Stackbase = 40 << 2
  30.  
  31.           HeapDescriptor = 57 << 2
  32.  
  33.           Abort = 63 << 2
  34.  
  35.           Backtrace = 64 << 2
  36.  
  37.           Fault = 95 << 2
  38.  
  39.           Loadpoint = 142 << 2
  40.  
  41.           Libterminateio = 143 << 2
  42.  
  43.           TopStore = 148 << 2
  44.  
  45.  
  46.  
  47.           .entry    enter
  48.  
  49.           .AREA     Code
  50.  
  51.           .include  "regnames"
  52.  
  53.           .include  "swinames"
  54.  
  55.           .include  "adr"
  56.  
  57.           rbcpl     = r4
  58.  
  59.           rmg       = r5
  60.  
  61.           rsect     = r6
  62.  
  63.           rbase     = r8
  64.  
  65. enter:    b         firstoff
  66.  
  67. St:       .ascii    "BCPL"
  68.  
  69.           .long     globinits - St
  70.  
  71.           .ascii    "bcplroot"
  72.  
  73.           .ascii    "14 Mar 90 00-00-00  "
  74.  
  75.           .long     0
  76.  
  77.           .long     -1
  78.  
  79.           .ascic    "Initial"
  80.  
  81. initial:  .LONG     0
  82.  
  83. firstoff: ldr       r8, [pc,#initial-$-8]
  84.  
  85.           ADR       r1, St
  86.  
  87.           mov       rmg, #100
  88.  
  89.           ldr       rbcpl, [r1]
  90.  
  91. sectlp1:  mov       rsect, a1
  92.  
  93.           ldmfd     a1, {a2, a3}        ;?"BCPL", glob
  94.  
  95.           cmp       a2, rbcpl           ; unless a1!1 = "BCPL" break
  96.  
  97.           bne       notsect
  98.  
  99.           add       a1, a3, a1          ; a1 := globinits
  100.  
  101. gl1:      ldmfd     a1!, {a2, a3}
  102.  
  103.           cmp       a3, #0              ; until a1!1 = 0 do a1 +:= 2
  104.  
  105.           bne       gl1
  106.  
  107.           cmp       a2, rmg
  108.  
  109.           movge     rmg, a2
  110.  
  111.           ldr       a3, [a1]
  112.  
  113.           ldr       a2, [pc,#onetwo-$-8]
  114.  
  115.           cmp       a2, a3
  116.  
  117.           bne       sectlp1             ; no relocations
  118.  
  119.           ldr       a2, [pc,#eightsev-$-8]
  120.  
  121.           add       a1, a1, #4
  122.  
  123.           cmp       rb, #0
  124.  
  125.           bne       norel
  126.  
  127. reloc:    ldmfd     a1!, {a3}
  128.  
  129.           cmp       a2, a3              ;until !a1 = eightsev
  130.  
  131.           ldrne     r0, [rsect, a3]
  132.  
  133.           addne     r0, r0, rsect
  134.  
  135.           strne     r0, [rsect, a3]     ;rsect!(!a1) +:= rsect
  136.  
  137.           bne       reloc
  138.  
  139.           b         sectlp1
  140.  
  141. onetwo:   .long     0x12345678
  142.  
  143. eightsev: .long     0x87654321
  144.  
  145. norel:    ldmfd     a1!, {a3}
  146.  
  147.           cmp       a2, a3
  148.  
  149.           bne       norel
  150.  
  151.           b         sectlp1
  152.  
  153. ;
  154.  
  155. ;         Relocations done and "BCPL", maxglob, sectbase set in r4, r5, r8;
  156.  
  157. ;         a1 set to point after last section.
  158.  
  159. ;
  160.  
  161. notsect:  add       rg, a1, #64         ;leave 16 words between code and globals
  162.  
  163.           add       rfp, rg, rmg,lsl #2 ;then the heap after rmg
  164.  
  165.           str       rmg, [rg]           ;g0 := #globals
  166.  
  167. illglob:  mov       r6, #0xAE000000
  168.  
  169.           add       r6, r6, #0x950000   ; illegal value for g0
  170.  
  171.           add       r6, r6, rmg, lsl #2
  172.  
  173.           str       r6, [rg,rmg,lsl #2] ; g!rmg :=#Xae950000 +4*rmg
  174.  
  175.           subs      rmg, rmg, #1        ; rmg -:= 1 repeatwhile rmg
  176.  
  177.           bne       illglob
  178.  
  179.           ADR       a1, St
  180.  
  181. glini:    ldmfd     a1, {a2,a3}
  182.  
  183.           cmp       a2, rbcpl           ; unless a1!0 = "BCPL" break
  184.  
  185.           bne       glinibr
  186.  
  187.           add       a1, a1, a3
  188.  
  189. glini1:   ldmfd     a1!, {a2,a3}
  190.  
  191.           cmp       a3, #0              ; a1 -> glob, offset or maxglob,0
  192.  
  193.           strne     a3, [rg, a2,lsl #2] ; g!a3 := 4*a2 (already relocated)
  194.  
  195.           bne       glini1
  196.  
  197.           ldr       a3, [a1]
  198.  
  199.           ldr       a2, [pc, #onetwo-$-8]
  200.  
  201.           cmp       a2, a3
  202.  
  203.           bne       glini               ; No relocations; next section
  204.  
  205.           ldr       a2, [pc, #eightsev-$-8]
  206.  
  207. glini2:   ldmfd     a1!, {a3}
  208.  
  209.           cmp       a2, a3
  210.  
  211.           bne       glini2              ; walk to end of sect
  212.  
  213.           b         glini
  214.  
  215. ;
  216.  
  217. ;         globals initialised; rg, rfp points to g0, g0 + rmg (+4) above.
  218.  
  219. ;
  220.  
  221. glinibr:  add       rfp, rfp, #4        ;frame pointer, empty frame, bos
  222.  
  223.           mov       r5, #0x100          ;C&S-brk resets, brk exits, esc ignored
  224.  
  225.           str       r5, [rg, #BrkEsc]
  226.  
  227.           mov       r5, #0x1000         ; default stackwords
  228.  
  229.           str       r5, [rg, #Stacksize]
  230.  
  231.           mov       r5, #0xae00
  232.  
  233.           add       r5, r5, #0x95
  234.  
  235.           ldr       rb, [rg, #StartInit]
  236.  
  237.           cmp       r5, rb, lsr #16
  238.  
  239.           blne      Call                ; Call if StartInit present
  240.  
  241.           strne     a1, [rg, #Stacksize]
  242.  
  243.           swi       OS_GetEnv
  244.  
  245.           str       r0, [pc, #saveregs-$-8]       ;*command
  246.  
  247.           sub       a1, a1, #1
  248.  
  249.           str       a1, [r9, #TopStore]
  250.  
  251.           mov       a3, a1              ; Top of addressable store
  252.  
  253.           mov       a1, rfp             ; Base   ""          ""
  254.  
  255.           str       a1, [rg, #HeapDescriptor]
  256.  
  257.           sub       a3, a3, a1          ; length available
  258.  
  259.           mov       a3, a3, lsr #2
  260.  
  261.           mov       a3, a3, lsl #2      ; must be wordsized
  262.  
  263.           mov       r0, #0              ; initialise heap
  264.  
  265.           swi       OS_Heap
  266.  
  267.           mov       r0, #2
  268.  
  269.           ldr       a3, [rg, #Stacksize]
  270.  
  271.           add       a3, a3, #1
  272.  
  273.           mov       a3, a3, lsl #2      ; Stackbytes + 4
  274.  
  275.           swi       OS_Heap
  276.  
  277.           mov       r5, a2, lsr #2
  278.  
  279.           add       r5, r5, #1
  280.  
  281.           str       r5, [rg, #Stackbase]; of Stacksize words
  282.  
  283.           mov       rfp, a2             ; with rfp as base
  284.  
  285.  
  286.           mov       a3, #264
  287.  
  288.           mov       r0, #2
  289.  
  290.           swi       OS_Heap             ; get space for Linebuff
  291.  
  292.           mov       r0, a2, lsr #2
  293.  
  294.           str       r0, [rg, #Instring] ; set Instring
  295.  
  296.           add       r0, r0, #2
  297.  
  298.           str       r0, [rg, #LineBuff] ; set Linebuf
  299.  
  300.           add       a2, a2, #4
  301.  
  302.           str       r0, [a2], #5       ; Instring!1 := Instring+2
  303.  
  304.           sub       a3, a2, #1         ; a3 = linebufB
  305.  
  306.           ldr       r0, [pc, #saveregs-$-8]
  307.  
  308. Walk:     ldrb      a1, [r0], #1
  309.  
  310.           cmp       a1, #32
  311.  
  312.           bgt       Walk
  313.  
  314.           subne     r0, r0, #1
  315.  
  316.           mov       a1, a2             ; Command tail to Linebuf!2
  317.  
  318.           mov       a2, #256
  319.  
  320.           swi       OS_GSTrans
  321.  
  322.           bvc       cmdl
  323.  
  324.           mov       a1, #12
  325.  
  326.           str       a1, [rg, #ReturnCode]
  327.  
  328.           ADR       a1, errcl
  329.  
  330.           mov       a1, a1, lsr #2
  331.  
  332.           ldr       rb, [rg, #Fault]
  333.  
  334.           bl        Call
  335.  
  336.           b         Finish              ; ? needed
  337.  
  338. errcl:    .asciz    "Bad CLine"
  339.  
  340.           .align
  341.  
  342.  
  343. cmdl:     strb      a2, [a3], #-8       ; Instring!0 := Linebuf%0
  344.  
  345.           str       a2, [a3]
  346.  
  347.           mov       r0, #0
  348.  
  349.           str       r0, [rg, #Outstring];Outstring := 0
  350.  
  351.  
  352.           ldr       a2, [rg,#Stacksize]
  353.  
  354.           rsb       a2, a2, #0          ; -StacksizeW
  355.  
  356.           str       a2, [rfp]
  357.  
  358.           sub       a3, rfp, a2, lsl #2 ; TOSB
  359.  
  360.           add       rfp, rfp, #4        ; Now Stackbase agrees with global
  361.  
  362.           mov       r0, #0
  363.  
  364.           mvn       a2, #0
  365.  
  366.           mov       a4, a3, lsr #2
  367.  
  368.           sub       a4, a4, #1
  369.  
  370.           stmea     rfp!, {r0, a2, a4}  ; sb!0, 1, 2, 3 := 0, -Sbw, TOSW, -Sbw
  371.  
  372.           mov       a1, #1              ; sb!5 only needed
  373.  
  374.           stmea     rfp!, {r0, a1, a2}    ; wrong!!!!!!!
  375.  
  376.           mov       rts, rfp            ; Empty frame
  377.  
  378. ;
  379.  
  380. ;stack shd be ffff0000, 0, ffff0000, tos,......,wordaddress at top
  381.  
  382. ; 148-174 ommitted
  383.  
  384. ;
  385.  
  386.           mov       r0, #65
  387.  
  388.           str       r0, [rg, #HostProc]
  389.  
  390.           mov       r0, #0
  391.  
  392.           str       r0, [pc, #Envflag - 8 - $]
  393.  
  394.           mov       a1, #0
  395.  
  396.           mov       a2, #0
  397.  
  398.           mvn       a3, #1
  399.  
  400.           ldr       a4, [rg, #Abort]
  401.  
  402.           mov       r5, #0xae00
  403.  
  404.           add       r5, r5, #0x95
  405.  
  406.           cmp       r5, a4, lsr #16
  407.  
  408.           streq     r0, [pc, #UInstr - 8 - $]
  409.  
  410.  
  411.  
  412.           blnv        NewEnv                  ; Remove nv
  413.  
  414.           ADR       r0, St
  415.  
  416.           mov       r0, r0, lsr #2
  417.  
  418.           str       r0, [rg, #Loadpoint]
  419.  
  420.           ldr       rgb, [pc, #Rgbval-8-$]
  421.  
  422.           add       rgb, rgb, #0x40000000
  423.  
  424.           mov       r0, #0
  425.  
  426.           str       r0, [rg, #ReturnCode]
  427.  
  428.           mov       r0, #1 << 24        ; Newline() not fast
  429.  
  430.           str       r0, [rg, #Cis]
  431.  
  432.           str       r0, [rg, #Cos]
  433.  
  434.           ldr       rb, [rg, #Start]
  435.  
  436.           bl        Call
  437.  
  438. Finish:   mov       rts, rfp
  439.  
  440. ;          ldr       rb, [rg, Libterminateio]      ;not needed
  441.  
  442. ;          bl        Call
  443.  
  444. Depart:   ldr       a1, [pc, #abex-8-$]
  445.  
  446.           ldr       a2, [rg, #ReturnCode]
  447.  
  448.           swi       OS_Exit
  449.  
  450. abex:     .ascii    "ABEX"
  451.  
  452.  
  453. saveregs: .blkl     16
  454.  
  455. Rgbval:   .long     Rgbs-4              ; Relocate these two
  456.  
  457.  
  458.           .long     -1
  459.  
  460.           .ascic    "ErrHand"
  461.  
  462. ErrHand:  movs      pc, lr
  463.  
  464. EscHand:  stmfd     rl!, {lr}
  465.  
  466.           mov       r0, #126
  467.  
  468.           swi       OS_Byte+XOS         ; Acknowledge Escape
  469.  
  470.           ldrb      r0, [rg, #BrkEsc]
  471.  
  472.           teq       r0, #0
  473.  
  474.           swine     OS_WriteS+XOS
  475.  
  476.           .asciz    "\c\nEscape\c\n"
  477.  
  478.           .align
  479.  
  480.           swine     OS_Exit
  481.  
  482.           ldmfd     rl!, {lr}
  483.  
  484.           movs      pc, lr
  485.  
  486.  
  487. BrkHand:  mov       pc, lr
  488.  
  489.  
  490.           .long     -1
  491.  
  492.           .ascic    "EvHandl"
  493.  
  494. EvHandl:  ADR       rts, EveRtnes       ; Call EveRtns!r0
  495.  
  496.           ldr       pc, [rts, r0, lsl #2]
  497.  
  498.  
  499. EvFlag:   ADR       rts, EveParams
  500.  
  501.           ldr       rts, [rts, r0, lsl #2]
  502.  
  503.           str       a1, [rts], #4
  504.  
  505.           str       a2, [rts], #4
  506.  
  507.           str       a3, [rts], #4
  508.  
  509.           str       a4, [rts], #4
  510.  
  511.           movs      pc, rl
  512.  
  513.  
  514. ErrBuff:  .blkl     16
  515.  
  516.  
  517.           .long     -1
  518.  
  519.           .ascic    "CBHandl"
  520.  
  521. CBHandl:  ADR       r0, CBBuff
  522.  
  523.           ldr       lr, [r0, #60]      ; Exit?
  524.  
  525. ;          tsts      lr, #3
  526.  
  527. ;          beq       CB3
  528.  
  529. ;          mov       a1, lr              ; keep safe svc_lr
  530.  
  531. ;          swi       OS_SetCallBack      ; another Callback
  532.  
  533. ;          mov       lr, a1
  534.  
  535.           ldmfd     r0, {r0-lr}
  536.  
  537.           movs      pc, lr
  538.  
  539. CBBuff:   .blkl     16
  540.  
  541.  
  542. EvBuff:   ADR       rts, EveParams
  543.  
  544.           ldr       rts, [rts, r0, lsl #2]
  545.  
  546.           mov       r0, r0, lsl #16
  547.  
  548.           orr       r0, r0, a1, lsl #8
  549.  
  550.           orr       r0, r0, a2
  551.  
  552.           ldmfd     rts!, {a1, a2, rl}
  553.  
  554.           add       a1, a1, #1
  555.  
  556.           moveq     a1, #0
  557.  
  558.           cmp       a1, a2
  559.  
  560.           strne     a1, [rts, #-12]
  561.  
  562.           mov       rl, #0
  563.  
  564. EvReturn: movs      pc, lr
  565.  
  566.  
  567. EveRtnes: .blkl     18                  ; 0-11 Events in Arthur
  568.  
  569. EveParams:.blkl     18                  ; 0-17   ""    Riscos
  570.  
  571.           .long     -1
  572.  
  573.           .ascic    "Seteven"
  574.  
  575. Seteven:  cmp       a3, #0
  576.  
  577.           ADR       a2, EvReturn
  578.  
  579.           beq       Evenex              ; ignore
  580.  
  581.           cmp       a3, #2
  582.  
  583.           ADRNE     a4, EveParams
  584.  
  585.           movne     a2, a2, lsl #2      ; flag(1) or buffer(3) BCPL
  586.  
  587.           strne     a2, [a4, a1, lsl #2]
  588.  
  589.           ADRNE     a2, EvFlag;
  590.  
  591.           cmpne     a3, #1
  592.  
  593.           ADRNE     a2, EvBuff
  594.  
  595. Evenex:   ADR       a4, EveRtnes       ; ARM Routine(2)
  596.  
  597.           strne     a2, [a4, a1, lsl #2]
  598.  
  599.           movs      pc, lr
  600.  
  601.  
  602. Uinhand:  str       lr, [pc, #Xcpbuf0-$-8]
  603.  
  604.           mov       lr, #1
  605.  
  606.           b         Hardhand
  607.  
  608. Pfahand:  str       lr, [pc, #Xcpbuf0-$-8]
  609.  
  610.           mov       lr, #2
  611.  
  612.           b         Hardhand
  613.  
  614. Dtahand:  str       lr, [pc, #Xcpbuf0-$-8]
  615.  
  616.           mov       lr, #3
  617.  
  618.           b         Hardhand
  619.  
  620. Adxhand:  str       lr, [pc, #Xcpbuf0-$-8]
  621.  
  622.           mov       lr, #4
  623.  
  624. Hardhand: str       lr, [pc, #Xcpbuf1-$-8]
  625.  
  626.           ADR       lr, XcpRegs
  627.  
  628.           stmea     lr, {r0 - lr}^
  629.  
  630.           tstp      pc, #0              ; leave svc mode
  631.  
  632.           swi       OS_WriteI+14
  633.  
  634.           add       rts, rfp, #160
  635.  
  636.           ldr       rb, [rg, #Abort]
  637.  
  638.           ldr       a1, [pc, #Xcpbuf1-$-8]
  639.  
  640.           ldr       lr, [pc, #Xcpbuf0-$-8]
  641.  
  642.           mov       pc, rb
  643.  
  644.  
  645.           .long     -1
  646.  
  647.           .ascic    "TKRErr "
  648.  
  649. TKRErr:   mov       a3, a1, lsl #2
  650.  
  651.           ADR       a4, ErrBuff+4
  652.  
  653.           mov       r5, #0
  654.  
  655. TKRlp:    ldrb      rb, [a4], #1
  656.  
  657.           cmp       rb, #0
  658.  
  659.           beq       TKRex
  660.  
  661.           add       r5, r5, #1
  662.  
  663.           strb      rb, [a3, r5]
  664.  
  665.           cmp       r5, a2
  666.  
  667.           blt       TKRlp
  668.  
  669. TKRex:    strb      r5, [a3]
  670.  
  671.           movs      pc, lr
  672.  
  673.  
  674.           .long     -1
  675.  
  676.           .ascic     "Stop   "
  677.  
  678. Stop:     str       a1, [rg, #ReturnCode]    ;? #ReturnCode
  679.  
  680.           ldr       a3, [rg, #Stackbase]
  681.  
  682.           mov       a3, a3, lsl #2
  683.  
  684.           ldr       a2, [a3, #4]
  685.  
  686.           ldr       rfp, [a3, #24]
  687.  
  688.           cmn       a2, #1
  689.  
  690.           beq       Finish
  691.  
  692.           b         ResCflt
  693.  
  694.           .long     -1
  695.  
  696.           .ascic    "Chenv  "
  697.  
  698. NewEnv:   ADR       a4, UInstr
  699.  
  700.           ADR       r5, OUInstr
  701.  
  702.           b         ChEnv
  703.  
  704. OldEnv:   ADR       a4, OUInstr
  705.  
  706.           ADR       r5, UInstr
  707.  
  708.           b         ChEnv
  709.  
  710.  
  711. XcpRegs:  .blkl     16
  712.  
  713. Xcpbuf0:  .blkl     1
  714.  
  715. Xcpbuf1:  .blkl     1
  716.  
  717. OUInstr:  .blkl     1
  718.  
  719. OPrefab:  .blkl     1
  720.  
  721. ODatab:   .blkl     1
  722.  
  723. OAddexp:  .blkl     1
  724.  
  725. OOtherx:  .blkl     1
  726.  
  727. OErrorH:  .blkl     3
  728.  
  729. OCallBH:  .blkl     3
  730.  
  731. OBreakPtH:.blkl     3
  732.  
  733. OEscapeH: .blkl     2
  734.  
  735. OEventH:  .blkl     2
  736.  
  737. OExitH:   .blkl     2
  738.  
  739. OUnusSWI: .blkl     2
  740.  
  741. OExcepReg:.blkl     1
  742.  
  743. OAplSp:   .blkl     1
  744.  
  745. OCao:     .blkl     1
  746.  
  747. OUpCall:  .blkl     2
  748.  
  749.  
  750. Envflag:  .address  0
  751.  
  752. UInstr:   .address  Uinhand
  753.  
  754. Prefab:   .address  Pfahand
  755.  
  756. Datab:    .address  Dtahand
  757.  
  758. Addexp:   .address  Adxhand
  759.  
  760. Otherx:   .address  0
  761.  
  762. ErrorH:   .address  ErrHand
  763.  
  764.           .address  0                   ; dont care
  765.  
  766.           .address  ErrBuff
  767.  
  768. CallBH:   .address  CBHandl
  769.  
  770.           .address  0
  771.  
  772.           .address  CBBuff
  773.  
  774. BreakPtH: .address  0
  775.  
  776.           .address  0
  777.  
  778.           .address  0
  779.  
  780. EscapeH:  .address  0
  781.  
  782.           .address  0
  783.  
  784. EventH:   .address  EvHandl
  785.  
  786.           .address  0
  787.  
  788. ExitH:    .address  Exithan
  789.  
  790.           .address  0
  791.  
  792. UnkSWI:   .address  0
  793.  
  794.           .address  0
  795.  
  796. ExcepReg: .address  0;XcpRegs
  797.  
  798. AplSp:    .address  0
  799.  
  800. Cao:      .address  0
  801.  
  802. UpCall:   .address  0
  803.  
  804.           .address  0
  805.  
  806.  
  807. ;Changenv Called with r0 case for OS_Changenv, a4 address of new value, r5
  808.  
  809. ;address to put old value; ends with a4, r5 incremented.
  810.  
  811.  
  812. ChEnv:    ldr       r0, [pc, #UInstr-$-8]
  813.  
  814.           cmp       r0, #0
  815.  
  816.           moveq     pc, lr
  817.  
  818.           mov       r0, #0              ; NB 0(Memlim not serviced)
  819.  
  820. Envlp:    mov       a2, #0
  821.  
  822.           mov       a3, #0
  823.  
  824.           add       r0, r0, #1
  825.  
  826.           ldr       a1, [a4], #4
  827.  
  828.           teq       r0, #0
  829.  
  830.           teqne     r0, #1
  831.  
  832.           teqne     r0, #2
  833.  
  834.           teqne     r0, #3
  835.  
  836.           teqne     r0, #4
  837.  
  838.           teqne     r0, #5
  839.  
  840.           teqne     r0, #13
  841.  
  842.           teqne     r0, #14
  843.  
  844.           teqne     r0, #15
  845.  
  846.           beq       Env1
  847.  
  848.           ldr       a2, [a4], #4
  849.  
  850.           teq       r0, #9
  851.  
  852.           teqne     r0, #10
  853.  
  854.           teqne     r0, #11
  855.  
  856.           teqne     r0, #12
  857.  
  858.           teqne     r0, #13
  859.  
  860.           teqne     r0, #16
  861.  
  862.           beq       Env1
  863.  
  864.           ldr       a3, [a4], #4
  865.  
  866. Env1:     swi       OS_ChangeEnvironment
  867.  
  868.           str       a1, [r5], #4
  869.  
  870.           teq       r0, #0
  871.  
  872.           teqne     r0, #1
  873.  
  874.           teqne     r0, #2
  875.  
  876.           teqne     r0, #3
  877.  
  878.           teqne     r0, #4
  879.  
  880.           teqne     r0, #5
  881.  
  882.           teqne     r0, #13
  883.  
  884.           teqne     r0, #14
  885.  
  886.           teqne     r0, #15
  887.  
  888.           beq       Envlp
  889.  
  890.           str       a2, [r5], #4
  891.  
  892.           teq       r0, #9
  893.  
  894.           teqne     r0, #10
  895.  
  896.           teqne     r0, #11
  897.  
  898.           teqne     r0, #12
  899.  
  900.           teqne     r0, #13
  901.  
  902.           beq       Envlp
  903.  
  904.           teq       r0, #16
  905.  
  906.           moveq     pc, lr
  907.  
  908.           str       a3, [r5], #4
  909.  
  910. Env2:     b         Envlp
  911.  
  912.  
  913. UPCHand:  stmia     r12, {r0-r5, lr}
  914.  
  915.           tst       r0, #256            ; R12 points to 7 word block
  916.  
  917.           ldreq     r0, [pc, #Envflag-$-pc]
  918.  
  919.           teqeq     r0, #1
  920.  
  921.           bne       UpEx
  922.  
  923.           bl        OldEnv
  924.  
  925.           mov       r0, #0
  926.  
  927.           str       r0, [pc, #Envflag-$-pc]
  928.  
  929. UpEx:     ldmia     r12, {r0-r5, lr}
  930.  
  931.           movs      pc, lr
  932.  
  933.  
  934. Exithan:  bl        OldEnv
  935.  
  936.           swi       OS_Exit
  937.  
  938.  
  939.           .long     -1
  940.  
  941.           .ascic    "OSCLI  "
  942.  
  943. OSCLI:    mov       r0, a1, lsl #2
  944.  
  945.           ldrb      a1, [r0], #1        ; string byte base, length
  946.  
  947.           add       a2, a1, r0          ; string byte terminator position
  948.  
  949.           ldrb      r3, [a2]
  950.  
  951.           mov       a4, #0
  952.  
  953.           strb      a4, [a2]
  954.  
  955.           ldr       a1, [pc, #Envflag-$-pc]
  956.  
  957.           cmp       a1, #0
  958.  
  959.           bne       SavEnv
  960.  
  961.           swi       OS_CLI+XOS
  962.  
  963.           strb      a3, [a2]
  964.  
  965.           mov       a1, #0
  966.  
  967.           mvnvs     a1, #0
  968.  
  969.           mov       pc, lr
  970.  
  971. SavEnv:   stmea     rts!, {lr}
  972.  
  973.           stmea     rts!, {a2, a3}
  974.  
  975.           bl        OldEnv
  976.  
  977.           swi       OS_CLI+XOS
  978.  
  979.           mov       a1, #0
  980.  
  981.           mvnvs     a1, #0
  982.  
  983. StEnv:    bl        NewEnv
  984.  
  985.           ldmea     rts!, {a2, a3}
  986.  
  987.           strb      a3, [a2]
  988.  
  989.           ldmea     rts!, {pc}
  990.  
  991.  
  992.           .long     -1                  ; needs a global
  993.  
  994.           .ascic    "RestEnv"
  995.  
  996. ResetEnv: ldr       a1, [pc, #Envflag-$-pc]
  997.  
  998.           cmp       a1, #1
  999.  
  1000.           moveq     pc, lr
  1001.  
  1002.           mov       r6, lr
  1003.  
  1004.           b         StEnv
  1005.  
  1006.  
  1007.           .long     -1
  1008.  
  1009.           .ascic    "Call   "
  1010.  
  1011. Call:     mov       pc, rb
  1012.  
  1013. Rgbs:     b         Depart
  1014.  
  1015. Mpy:      stmfd     rg, {a4, lr}        ; mpy
  1016.  
  1017.           mov       a4, #0
  1018.  
  1019.           movs      lr, a2
  1020.  
  1021.           rsbmi     lr, lr, #0
  1022.  
  1023. Mpylp:    movs      lr, lr, lsr #1
  1024.  
  1025.           addcs     a4, a4, a1
  1026.  
  1027.           mov       a1, a1, lsl #1
  1028.  
  1029.           bne       Mpylp
  1030.  
  1031.           mov       a1, a4
  1032.  
  1033.           teqs      a2, #0
  1034.  
  1035.           rsbmi     a1, a1, #0
  1036.  
  1037.           ldmea     rg, {a4,pc}^
  1038.  
  1039.  
  1040. Div:      stmfd     rg, {a3-r5,lr}      ; a1/a2, a1 rem a2
  1041.  
  1042.           movs      lr, a1
  1043.  
  1044.           rsbmi     lr, lr, #0
  1045.  
  1046.           movs      a3, a2
  1047.  
  1048.           beq       DivZero             ; Divide by zero fault
  1049.  
  1050.           rsbmi     a3, a3, #0
  1051.  
  1052.           mov       a4, #0
  1053.  
  1054.           mov       r5, #1
  1055.  
  1056. Divl1:    cmp       a3, #0x80000000
  1057.  
  1058.           cmpcc     a3, lr
  1059.  
  1060.           movcc     a3, a3, lsl #1
  1061.  
  1062.           movcc     r5, r5, lsl #1
  1063.  
  1064.           bcc       Divl1
  1065.  
  1066. Divl2:    cmp       a3, lr
  1067.  
  1068.           addls     a4, a4, r5
  1069.  
  1070.           subls     lr, lr, a3
  1071.  
  1072.           movs      r5, r5, lsr #1
  1073.  
  1074.           movne     a3, a3, lsr #1
  1075.  
  1076.           bne       Divl2
  1077.  
  1078.           teqs      a1, a2
  1079.  
  1080.           rsbmi     a4, a4, #0
  1081.  
  1082.           cmp       a1, #0
  1083.  
  1084.           mov       a2, lr
  1085.  
  1086.           rsblt     a2, a2, #0
  1087.  
  1088.           mov       a1, a4
  1089.  
  1090.           ldmea     rg, {a3-r5, pc}^   ; a1, a2 = a1/a2, a1 rem a2
  1091.  
  1092.  
  1093.           movnv     r0,r0
  1094.  
  1095.           stmea     rts!, {rb, fp, sp, lr}
  1096.  
  1097.           sub       fp, rts, #16
  1098.  
  1099.           ldr       rl, [rb, #-4]
  1100.  
  1101.           ldr       r0, [rb, #4]
  1102.  
  1103.           add       r0, r0, #1
  1104.  
  1105.           str       r0, [rb, #4]
  1106.  
  1107.           ldr       pc, [rb, #8]        ; ????????????
  1108.  
  1109.  
  1110.           add       lr, lr, #4
  1111.  
  1112.           stmfd     rg, {r0, lr}
  1113.  
  1114.           bic       lr, lr, #0xfc000000
  1115.  
  1116.           ldr       r0, [r5]
  1117.  
  1118.           ldmea     rg, {r0, pc}^
  1119.  
  1120. DivZero:  mov       a1, #12
  1121.  
  1122.           str       a1, [rg, #ReturnCode]
  1123.  
  1124.           ADR       a1, Divz
  1125.  
  1126.           b         Faults       ; in ResumeC
  1127.  
  1128. Divz:     .ascic    "Division by zero\0"
  1129.  
  1130.           .align
  1131.  
  1132.  
  1133.           .long     -1
  1134.  
  1135.           .ascic    "Muldiv "
  1136.  
  1137. Muldiv:   stmea     rts!, {rb, rfp, rl, lr }
  1138.  
  1139.           sub       rfp, rts, #16
  1140.  
  1141.           stmea     rts!, {a1, a2, a3}
  1142.  
  1143.           cmp       a2, #0
  1144.  
  1145.           beq       Divz
  1146.  
  1147.           cmp       a1, #0
  1148.  
  1149.           rsblt     a1, a1, #0
  1150.  
  1151.           cmp       a2, #0
  1152.  
  1153.           rsblt     a2, a2, #0          ; a1, a2 := mod a1, mod a2
  1154.  
  1155.           mov       r0, a1, lsr #16     ; a1 hi
  1156.  
  1157.           mov       a4, a2, lsr #16     ; a2 hi
  1158.  
  1159.           bic       a1, a1, r0, lsl #16 ; a1 lo
  1160.  
  1161.           bic       a2, a2, a4, lsl #16 ; a2 lo
  1162.  
  1163.           mul       a3, a1, a2          ; bits 0-15+part 16-31
  1164.  
  1165.           mul       a2, r0, a2          ; part bits 16-47
  1166.  
  1167.           mul       a1, a4, a1          ;  ""        ""
  1168.  
  1169.           mul       a4, r0, a4          ; part bits 32-47 + bits 48-63
  1170.  
  1171.           adds      a1, a2, a1
  1172.  
  1173.           addcs     a4, a4, #0x10000     ; carry from middle
  1174.  
  1175.           adds      a3, a3, a1, lsl #16
  1176.  
  1177.           adc       a4, a4, a1, lsr #16 ; result in a3(lo)-a4(hi)
  1178.  
  1179.  
  1180.           ldmea     rts, {r5}           ; divisor
  1181.  
  1182.           mov       a1, #0              ; dividend
  1183.  
  1184.           mov       a2, #0              ; remainder
  1185.  
  1186.           mov       r0, #64             ; count
  1187.  
  1188. divlp1:   subs      r0, r0, #1
  1189.  
  1190.           beq       DivDone
  1191.  
  1192.           adds      a3, a3, a3
  1193.  
  1194.           adcs      a4, a4, a4
  1195.  
  1196.           bpl       divlp1              ; a4 bit 31 now set
  1197.  
  1198. divlp2:   adds      a3, a3, a3
  1199.  
  1200.           adcs      a4, a4, a4
  1201.  
  1202.           adc       a2, a2, a2          ; rem := Rem*2+Carry
  1203.  
  1204.           cmp       a2, r5
  1205.  
  1206.           subcs     a2, a2, r5          ; rem -:= divisor
  1207.  
  1208.           adcs       a1, a1, a1         ; div := div*2+Carry
  1209.  
  1210.           bcs       Toobig
  1211.  
  1212. divsm:    subs      r0, r0, #1
  1213.  
  1214.           bne       divlp2
  1215.  
  1216.  
  1217. DivDone:  str       a2, [rg, #Result2]
  1218.  
  1219.           ldmea     rts!, {a3-r5}
  1220.  
  1221.           eors      a3, a3, a4
  1222.  
  1223.           rsblt     a1, a1, #0
  1224.  
  1225.           eors      a3, a4, r5
  1226.  
  1227. ;          rsblt     a2, a2, #0
  1228.  
  1229.           ldmea     rts!, {rb, rfp, rl, pc}^
  1230.  
  1231. Toobig:   mov       a1, #15
  1232.  
  1233.           str       a1, [rg, #ReturnCode]
  1234.  
  1235.           ADR       a1, oflo
  1236.  
  1237.           b         Faults
  1238.  
  1239. oflo:     .ascic    "Muldiv result oflo\0"
  1240.  
  1241.  
  1242.           .align
  1243.  
  1244.           .long     -1
  1245.  
  1246.           .ascic    "OSByte "
  1247.  
  1248. OSByte:   mov       r0, a1
  1249.  
  1250.           mov       a1, a2
  1251.  
  1252.           mov       a2, a3
  1253.  
  1254.           swi       OS_Byte
  1255.  
  1256.           str       a2, [rg, #Result2]
  1257.  
  1258.           movs      pc, lr
  1259.  
  1260.  
  1261.           .long     -1
  1262.  
  1263.           .ascic    "OSWord "
  1264.  
  1265. OSWord:   and       r0, a1, #0xff
  1266.  
  1267.           mov       a1, a2, lsl #2
  1268.  
  1269.           swi       OS_Word
  1270.  
  1271.           movs      pc, lr              ; nb if p0 = 0 OS_Readline ISNT Called.
  1272.  
  1273.  
  1274.           .long     -1
  1275.  
  1276.           .ascic    "OSArgs "
  1277.  
  1278. OSArgs:   mov       r0, a1
  1279.  
  1280.           mov       a1, a2
  1281.  
  1282.           mov       a2, a3
  1283.  
  1284.           swi       OS_Args
  1285.  
  1286.           mov       a1, a2
  1287.  
  1288.           str       r0, [rg, #Result2]
  1289.  
  1290.           movs      pc, lr
  1291.  
  1292.  
  1293.           .long     -1
  1294.  
  1295.           .ascic    "OSFile "
  1296.  
  1297. OSFile:   stmea     rts!, {nil}
  1298.  
  1299.           mov       r0, a1
  1300.  
  1301.           cmp       a2, #0
  1302.  
  1303.           movlt     nil, #0
  1304.  
  1305.           movlt     a1, #0
  1306.  
  1307.           sublt     a1, a1, a2
  1308.  
  1309.           mvnge     nil, #0
  1310.  
  1311.           movge     a1, a2, lsl #2
  1312.  
  1313.           ldrgeb    a2, [a1], #1        ; string byte base, length
  1314.  
  1315.           addge     a4, a2, a1          ; string byte terminator position
  1316.  
  1317.           ldrgeb    r5, [a4]
  1318.  
  1319.           movge     rb, #0
  1320.  
  1321.           strgeb    rb, [a4]
  1322.  
  1323.           stmea     rts!, {a4, r5}
  1324.  
  1325.           mov       rb, a3, lsl #2
  1326.  
  1327.           ldr       a2, [a1]
  1328.  
  1329.           cmp       a2, #0
  1330.  
  1331.           addeq     a1, a1, #1
  1332.  
  1333.           ldmia     rb, {a2-r5}
  1334.  
  1335.           swi       OS_File + XOS
  1336.  
  1337.           stmia     rb, {a2-r5}
  1338.  
  1339.           mov       a2, #0
  1340.  
  1341.           mvnvs     a2, #0
  1342.  
  1343.           str       a2, [rg, #Result2]
  1344.  
  1345.           mov       a1, r0
  1346.  
  1347.           ldmea     rts!, {a4, r5}
  1348.  
  1349.           cmp       nil, #0
  1350.  
  1351.           strneb    r5, [a4]            ; restore
  1352.  
  1353.           ldmea     rts!, {nil}
  1354.  
  1355.           movs      pc, lr
  1356.  
  1357.  
  1358.           .long     -1
  1359.  
  1360.           .ascic    "OSWrCh "
  1361.  
  1362. OSWrCh:   mov       r0, a1
  1363.  
  1364.           swi       OS_WriteC
  1365.  
  1366.           movs      pc, lr
  1367.  
  1368.  
  1369.           .long     -1
  1370.  
  1371.           .ascic    "OSRdCh "
  1372.  
  1373. OSRdCh:   swi       OS_ReadC
  1374.  
  1375.           mov       a1, r0
  1376.  
  1377.           mov       r0, #0
  1378.  
  1379.           mvncs     r0, #0
  1380.  
  1381.           str       r0, [rg, #Result2]
  1382.  
  1383.           movs      pc, lr
  1384.  
  1385.  
  1386.           .long     -1
  1387.  
  1388.           .ascic    "OSBPut "
  1389.  
  1390. OSBPut:   mov       r0, a1
  1391.  
  1392.           mov       a1, a2
  1393.  
  1394.           swi       OS_BPut
  1395.  
  1396.           movs      pc, lr
  1397.  
  1398.  
  1399.           .long     -1
  1400.  
  1401.           .ascic    "OSBGet "
  1402.  
  1403. OSBGet:   swi       OS_BGet+XOS
  1404.  
  1405.           mov       a1, r0
  1406.  
  1407.           movcs     a1, #0xff
  1408.  
  1409.           movcs     a1, a1, lsl #1
  1410.  
  1411.           movs      pc, lr
  1412.  
  1413.  
  1414.           .long     -1
  1415.  
  1416.           .ascic    "Level  "
  1417.  
  1418. Level:    mov       a1, rfp
  1419.  
  1420.           movs      pc, lr
  1421.  
  1422.  
  1423.           .long     -1
  1424.  
  1425.           .ascic    "LongJum"
  1426.  
  1427. LongJump: cmp       rfp, a1
  1428.  
  1429.           moveq     pc, a2              ; Same level
  1430.  
  1431.           mov       a4, rfp
  1432.  
  1433. LJ1:      ldr       r5, [a4, #4]        ; rfp enclosing frame rfp!1
  1434.  
  1435.           cmp       r5, a4
  1436.  
  1437.           beq       LJ2                 ; base of stack?
  1438.  
  1439.           cmp       r5, a1              ; enclosing frame correct?
  1440.  
  1441.           movne     a4, r5
  1442.  
  1443.           bne       LJ1
  1444.  
  1445.           ldr       rl, [a4, #8]        ; rl of found frame  rfp!2
  1446.  
  1447.           mov       rts, a4
  1448.  
  1449.           mov       rfp, a1
  1450.  
  1451.           mov       pc, a2              ; successful
  1452.  
  1453. LJ2:      mov       a3, a1
  1454.  
  1455.           mov       a1, #14
  1456.  
  1457.           str       a1, [rg, #ReturnCode]
  1458.  
  1459.           str       r2, [ rg, #Result2 ]
  1460.  
  1461.           ADR       a1, LJRep
  1462.  
  1463.           b         Faults
  1464.  
  1465. LJRep:    .ascic    "Destination frame %n for LongJump in the stack\0"
  1466.  
  1467.           .align
  1468.  
  1469.  
  1470.           .long     -1
  1471.  
  1472.           .ascic    "GBytes "
  1473.  
  1474. GBytes:   mov       r0, a1
  1475.  
  1476.           mov       a1, #0              ; returns last 4 bytes ( max a2 )
  1477.  
  1478. GBloop:   ldrb      a3, [r0], #1        ; from a1 (not wrd aligned) in one word
  1479.  
  1480.           add       a1, a3, a1, lsl #8  ; Byteword := GBytes( Byteaddr, Number )
  1481.  
  1482.           subs      a2, a2, #1
  1483.  
  1484.           bgt       GBloop
  1485.  
  1486.           movs      pc, lr
  1487.  
  1488.  
  1489.           .long     -1
  1490.  
  1491.           .ascic    "PBytes "
  1492.  
  1493. PBytes:   add       a1, a1, a2          ; PBytes( Byteword, Number, Byteaddr )
  1494.  
  1495. PBloop:   strb      a3, [a1, #-1]
  1496.  
  1497.           subs      a2, a2, #1
  1498.  
  1499.           bgt       PBloop
  1500.  
  1501.           movs      pc, lr
  1502.  
  1503.  
  1504.           .long     -1
  1505.  
  1506.           .ascic    "Move   "
  1507.  
  1508. Move:     mov       a4, a2, lsl #2      ; to b
  1509.  
  1510.           mov       a2, a3
  1511.  
  1512.           mov       a3, a1, lsl #2      ; from b
  1513.  
  1514.           mov       a1, #1
  1515.  
  1516.           b         MWLoop
  1517.  
  1518.  
  1519.           .long     -1
  1520.  
  1521.           .ascic    "Backmov"
  1522.  
  1523. BackMov:  add       a4, a2, a3          ; to w
  1524.  
  1525.           mov       a2, a3
  1526.  
  1527.           add       a3, a1, a3          ; from w
  1528.  
  1529.           mvn       a1, #0
  1530.  
  1531.           b         MoveWo
  1532.  
  1533.  
  1534.           .long     -1
  1535.  
  1536.           .ascic    "MoveWor"
  1537.  
  1538. MoveWo:   mov       a4, a4, lsl #2
  1539.  
  1540.           mov       a3, a3, lsl #2
  1541.  
  1542. MWLoop:   ldr       r0, [a3], a1,lsl #2 ; a3 postindex icr/decr by a1
  1543.  
  1544.           str       r0, [a4], a1,lsl #2
  1545.  
  1546.           subs      a2, a2, #1
  1547.  
  1548.           bgt       MWLoop
  1549.  
  1550.           mov       pc, lr
  1551.  
  1552.  
  1553.           .long     -1
  1554.  
  1555.           .ascic    "FillWor"
  1556.  
  1557. FillWo:   mov       a1, a1, lsl #2
  1558.  
  1559. Filloop:  str       a3, [a1], #4
  1560.  
  1561.           subs      a2, a2, #1
  1562.  
  1563.           bgt       Filloop
  1564.  
  1565.           movs      pc, lr
  1566.  
  1567.  
  1568.           .LONG     -1
  1569.  
  1570.           .ascic    "Movebyt"
  1571.  
  1572. Movebyte: cmp       a3, #0
  1573.  
  1574.           moveq     pc, lr
  1575.  
  1576. mb:       ldrb      r0, [a1], #1
  1577.  
  1578.           strb      r0, [a2], #1
  1579.  
  1580.           subs      a3, a3, #1
  1581.  
  1582.           bgt       mb
  1583.  
  1584.           mov       pc, lr
  1585.  
  1586.  
  1587.           .long     -1
  1588.  
  1589.           .ascic    "Backmvb"
  1590.  
  1591. Backmvby: cmp       a3, #0
  1592.  
  1593.           moveq     pc, lr
  1594.  
  1595. bmb:      subs      a3, a3, #1
  1596.  
  1597.           ldrb      r0, [ a1, a3 ]
  1598.  
  1599.           strb      r0, [ a2, a3 ]
  1600.  
  1601.           bgt       bmb
  1602.  
  1603.           mov       pc, lr
  1604.  
  1605.  
  1606.           .long     -1
  1607.  
  1608.           .ascic    "CoWait "           ; CoWait( Coptr )
  1609.  
  1610. CoWait:   stmea     rts!, {rb, rfp, rl, lr} ; fp!0, 1, 2, 3 :=
  1611.  
  1612.                                         ;      Called, Calling fp, statics, link
  1613.  
  1614.           sub       rfp, rts, #16       ; frame pointer
  1615.  
  1616.           stmea     rts!, {a1}          ; fp!4 := coptr
  1617.  
  1618.           ldr       a2, [rg, #Stackbase]; Current Stackbase
  1619.  
  1620.           mov       a2, a2, lsl #2
  1621.  
  1622.           ldr       a3, [a2, #4]        ; sb := sb!1
  1623.  
  1624.           cmns      a3, #1
  1625.  
  1626.           beq       ResCflt             ; sb!1=-1 -> Mainstack
  1627.  
  1628.           str       a3, [rg, #Stackbase];      otherwise Calling stack
  1629.  
  1630.           mov       a4, #0
  1631.  
  1632.           str       a4, [a2, #4]        ;     := 0 -> waiting
  1633.  
  1634.           str       rfp, [a2, #16]      ; sb!4 := frameptr for resume
  1635.  
  1636.           mov       a3, a3, lsl #2
  1637.  
  1638.           ldr       rfp, [a3, #16]      ; frptr = Oldsb!4
  1639.  
  1640.           ldmed     rfp, {rfp, rl, pc}^ ; frameptr, statics, resumepc :=
  1641.  
  1642.                                         ;         frameptr!4, 3, 2
  1643.  
  1644.           .long     -1
  1645.  
  1646.           .ascic    "CreateC"          ; (function, stack#)
  1647.  
  1648. CreateC:  stmea     rts!, {rb, rfp, rl, lr}
  1649.  
  1650.           sub       rfp, rts, #16
  1651.  
  1652.           stmea     rts!, {a1, a2}
  1653.  
  1654.           mov       a1, a2
  1655.  
  1656.           bl        GetVec
  1657.  
  1658.           cmps      a1, #0              ; if v = 0 goto ResCflt
  1659.  
  1660.           beq       ResCflt
  1661.  
  1662.           ldmea     rts!, {a4, lr}
  1663.  
  1664.           add       lr, a1, lr          ; lr := v+Stack#, i.e Stacktopword(Stw)
  1665.  
  1666.           mov       a2, a1, lsl #2      ; a2 := Stackbotbyte(Sbb)
  1667.  
  1668.           ldr       rb, [rg, #Stackbase]
  1669.  
  1670.           mov       a3, rb, lsl #2
  1671.  
  1672.           ldr       r5, [a3]
  1673.  
  1674.           str       a1, [a3]            ; oldsb!0 := Stack#
  1675.  
  1676.           stmea     a2, {r5, rb, lr}    ; sb!0, 1, 2 := Oldsb!0, owning sbW, Stw
  1677.  
  1678.           str       a4, [a2, #20]       ; sb!5 := function
  1679.  
  1680.           str       a3, [a2, #16]       ; sb!4 := OwningsbB
  1681.  
  1682.           str       a1, [rg, #Stackbase]; Stackbase := StackbaseW
  1683.  
  1684.           add       rfp, a2, #24
  1685.  
  1686. ccret:    mov       rts, rfp
  1687.  
  1688.           bl        CoWait
  1689.  
  1690.           ldr       rb, [rfp, #-4]      ; function
  1691.  
  1692.           bl        Call
  1693.  
  1694.           b         ccret               ; loop
  1695.  
  1696.  
  1697.           .long     -1
  1698.  
  1699.           .ascic    "DeleteC"
  1700.  
  1701. DeleteC:  stmea     rts!, {rb, rfp, rl, lr}
  1702.  
  1703.           sub       rfp, rts,  #16
  1704.  
  1705.           stmea     rts!, {a1}          ;(coptr) returns successcode
  1706.  
  1707.           mov       a2, a1, lsl #2
  1708.  
  1709.           ldr       a3, [a2, #4]        ; sb!1
  1710.  
  1711.           cmp       a3, #0
  1712.  
  1713.           bne       ResCflt              ; not a stack
  1714.  
  1715.           ldr       a3, [rg, #Stackbase]
  1716.  
  1717. dlc1:     mov       a4, a4, lsl #2
  1718.  
  1719.           ldr       a4, [a4, #4]
  1720.  
  1721.           cmn       a4, #1              ; if owningsb!1 \= -1,ie nain, loop
  1722.  
  1723.           bne       dlc1
  1724.  
  1725.           mov       r0, #0
  1726.  
  1727. dlcl2:    mov       a4, a3
  1728.  
  1729.           ldr       a3, [r0, a3, lsl #2]
  1730.  
  1731.           cmp       a3, 0
  1732.  
  1733.           beq       ResCflt
  1734.  
  1735.           cmp       a1, a3              ; Coptr
  1736.  
  1737.           bne       dlcl2
  1738.  
  1739.           ldr       a2, [r0, a1, lsl #2]
  1740.  
  1741.           str       a2, [r0, a4, lsl #2]
  1742.  
  1743.           bl        FreeVec
  1744.  
  1745.           mov       rts, rfp
  1746.  
  1747.           ldmed     rts, {rfp, rl, pc}^
  1748.  
  1749.  
  1750.           .long     -1
  1751.  
  1752.           .ascic    "CallCo "
  1753.  
  1754. CallCo:   stmea     rts!, {rb, rfp, rl, lr}
  1755.  
  1756.           sub       rfp, rts, #16
  1757.  
  1758.           stmea     rts!, {a1, a2}       ; CallCo( Coptr, arg )
  1759.  
  1760.           mov       a3, a1, lsl #2
  1761.  
  1762.           ldr       a4, [a3, #4]        ; if coptr!1 = 0 goto ResCflt
  1763.  
  1764.           cmp       a4, #0
  1765.  
  1766.           bne       ResCflt              ; Not waiting
  1767.  
  1768.           ldr       rb, [rg, #Stackbase]
  1769.  
  1770.           str       rb, [a3, #4]        ; Coptr!1 := Calling Stackbase
  1771.  
  1772.           mov       rb, rb, lsl #2
  1773.  
  1774. CallCo1:  str       a1, [rg, #Stackbase]; Stackbase := Coptr
  1775.  
  1776.           str       rfp, [rb, #16]      ; OldStackbase!4 := rfp
  1777.  
  1778.           ldr       rts, [a3, #16]      ; rts := Coptr!4
  1779.  
  1780.           mov       a1, a2              ; arg
  1781.  
  1782.           ldmed     rts, {rfp, rl, pc}^
  1783.  
  1784.  
  1785.           .long     -1
  1786.  
  1787.           .asciC    "ResumeC"
  1788.  
  1789. ResumeC:  stmea     rts!, { rb,rfp, rl, lr}
  1790.  
  1791.           sub       rfp, rts, #16
  1792.  
  1793.           stmea     rts!, {a1, a2}      ; ResumeCo( coptr, Arg )
  1794.  
  1795.           ldr       rb, [rg, #Stackbase]
  1796.  
  1797.           cmp       rb, a1              ; Resume oneself == Call
  1798.  
  1799.           beq       resco2
  1800.  
  1801.           mov       a3, a1, lsl #2
  1802.  
  1803.           ldr       a4, [a3, #4]        ; a4 := owner
  1804.  
  1805.           bne       ResCflt              ; Exists, error return
  1806.  
  1807.           mov       rb, rb, lsl #2
  1808.  
  1809. resco3:   ldr       a4, [rb, #4]
  1810.  
  1811.           cmns      a4, #1
  1812.  
  1813.           beq       ResCflt
  1814.  
  1815.           str       a4, [a3, #4]        ; owner of new := Owner of old
  1816.  
  1817.           mov       a4, #0
  1818.  
  1819.           str       a4, [rb, #4]        ; CoWait old
  1820.  
  1821.           b         CallCo1
  1822.  
  1823. resco2:   mov       a1, a2
  1824.  
  1825.           mov       rts, rfp
  1826.  
  1827.           ldmed     rts, {rfp, rl, lr}^
  1828.  
  1829. ResCflt:  ADR       a1, ResCerr
  1830.  
  1831.           mov       a1, #13
  1832.  
  1833.           str       a1, [rg, #ReturnCode]
  1834.  
  1835. Faults:   mov       a1, a1, lsr #2
  1836.  
  1837.           ldr       rb, [rg, #Fault]
  1838.  
  1839.           swi       OS_NewLine
  1840.  
  1841.           bl        Call
  1842.  
  1843.           b         Finish
  1844.  
  1845. ResCerr:  .ascic    "Coroutine error\n"
  1846.  
  1847.           .align
  1848.  
  1849. ResC78:   .ascii    "VERN"
  1850.  
  1851.           .long     -1
  1852.  
  1853.           .ascic    "GetVect"
  1854.  
  1855. GetVec:   mov       r0, #2
  1856.  
  1857.           add       a1, a1, #1
  1858.  
  1859.           mov       a3, a1, lsl #2
  1860.  
  1861. Comvec:   ldr       a1, [rg, #HeapDescriptor]
  1862.  
  1863.           swi       OS_Heap + XOS
  1864.  
  1865.           mov       a1, a2, lsr #2
  1866.  
  1867.           movvc     r0, #0
  1868.  
  1869.           mvnvs     r0, #0
  1870.  
  1871.           str       r0, [ rg, #Result2 ]
  1872.  
  1873.           movvc     pc, lr               ; error return now if Result2
  1874.  
  1875.           ADR       a1, Gv
  1876.  
  1877.           b         Faults
  1878.  
  1879. Gv:       .ascic    "Heap fault"
  1880.  
  1881.           .align
  1882.  
  1883.           .long     -1
  1884.  
  1885.           .ascic     "MaxVect"
  1886.  
  1887. MaxVec:   mov       r0, #1
  1888.  
  1889.           b         Comvec
  1890.  
  1891.           .long     -1
  1892.  
  1893.           .ascic    "FreeVec"
  1894.  
  1895. FreeVec:  cmp       a1, #0
  1896.  
  1897.           moveq     pc, lr              ; return if 0
  1898.  
  1899.           mov       r0, #3
  1900.  
  1901.           mov       a2, a1, lsl #2
  1902.  
  1903.           b         Comvec
  1904.  
  1905. hexbuf:   .blkb     9
  1906.  
  1907.           .align
  1908.  
  1909.  
  1910.           .long     -1
  1911.  
  1912.           .ascic    "OSFind "
  1913.  
  1914. OSFind:   movs      r0, a1
  1915.  
  1916.           bne       OSFOpen
  1917.  
  1918.           mov       a1, a2              ; handle
  1919.  
  1920.           swi       OS_Find
  1921.  
  1922.           mov       a1, r0
  1923.  
  1924.           mov       pc, lr
  1925.  
  1926.  
  1927. OSFOpen:  cmp       a2, #0
  1928.  
  1929.           mvnle     a4, #0
  1930.  
  1931.           movlt     a1, #0
  1932.  
  1933.           sublt     a1, a1, a2
  1934.  
  1935.           movge     a1, a2, lsl #2
  1936.  
  1937.           ldrgeb    a2, [a1], #1        ; string byte base, length
  1938.  
  1939.           addge     a3, a2, a1          ; string byte terminator position
  1940.  
  1941.           ldrgeb   a4, [a3]
  1942.  
  1943.           movge     r5, #0
  1944.  
  1945.           strgeb    r5, [a3]
  1946.  
  1947.           swi       OS_Find+XOS
  1948.  
  1949.           movvc     a1, #0
  1950.  
  1951.           mvnvs     a1, #0
  1952.  
  1953.           str       a1, [rg, #Result2]
  1954.  
  1955.           cmp       a4, #0
  1956.  
  1957.           strgeb    a4, [a3]            ; restore
  1958.  
  1959.           mov       a1, r0
  1960.  
  1961.           mov       pc, lr
  1962.  
  1963. globinits:
  1964.  
  1965.           .long     16
  1966.  
  1967.           .long     Muldiv - St
  1968.  
  1969.           .long     35
  1970.  
  1971.           .long     Stop - St
  1972.  
  1973.           .long     37
  1974.  
  1975.           .long     GBytes - St
  1976.  
  1977.           .long     38
  1978.  
  1979.           .long     PBytes - St
  1980.  
  1981.           .long     41
  1982.  
  1983.           .long     Level  - St
  1984.  
  1985.           .long     42
  1986.  
  1987.           .long     LongJump - St
  1988.  
  1989.           .long     48
  1990.  
  1991.           .long     CreateC - St
  1992.  
  1993.           .long     49
  1994.  
  1995.           .long     DeleteC - St
  1996.  
  1997.           .long     50
  1998.  
  1999.           .long     CallCo - St
  2000.  
  2001.           .long     51
  2002.  
  2003.           .long     ResumeC - St
  2004.  
  2005.           .long     52
  2006.  
  2007.           .long     CoWait - St
  2008.  
  2009.           .long     54
  2010.  
  2011.           .long     GetVec - St
  2012.  
  2013.           .long     55
  2014.  
  2015.           .long     FreeVec - St
  2016.  
  2017.           .long     56
  2018.  
  2019.           .long     MaxVec - St
  2020.  
  2021.           .long     96
  2022.  
  2023.           .long     OSArgs - St
  2024.  
  2025.           .long     97
  2026.  
  2027.           .long     OSBGet - St
  2028.  
  2029.           .long     98
  2030.  
  2031.           .long     OSBPut - St
  2032.  
  2033.           .long     99
  2034.  
  2035.           .long     OSFind - St
  2036.  
  2037.           .long     100
  2038.  
  2039.           .long     OSFile - St
  2040.  
  2041.           .long     101
  2042.  
  2043.           .long     OSCLI - St
  2044.  
  2045.           .long     102
  2046.  
  2047.           .long     OSWrCh - St
  2048.  
  2049.           .long     103
  2050.  
  2051.           .long     OSRdCh - St
  2052.  
  2053.           .long     104
  2054.  
  2055.           .long     OSByte - St
  2056.  
  2057.           .long     105
  2058.  
  2059.           .long     OSWord - St
  2060.  
  2061.           .long     106
  2062.  
  2063.           .long     TKRErr - St
  2064.  
  2065.           .long     135
  2066.  
  2067.           .long     ResetEnv - St
  2068.  
  2069.           .long     136
  2070.  
  2071.           .long     Move - St
  2072.  
  2073.           .long     137
  2074.  
  2075.           .long     BackMov - St
  2076.  
  2077.           .long     138
  2078.  
  2079.           .long     Movebyte - St
  2080.  
  2081.           .long     139
  2082.  
  2083.           .long     Backmvby - St
  2084.  
  2085.           .long     140
  2086.  
  2087.           .long     MoveWo - St
  2088.  
  2089.           .long     141
  2090.  
  2091.           .long     FillWo - St
  2092.  
  2093.           .long     Stackbase
  2094.  
  2095.           .long     FillWo - St
  2096.  
  2097.           .long     150
  2098.  
  2099.           .long     0
  2100.  
  2101.           .long     0x12345678
  2102.  
  2103.           .long     globinits           ; not +4 because b instr at head
  2104.  
  2105.           .long     globinits+8
  2106.  
  2107.           .long     globinits+16
  2108.  
  2109.           .long     globinits+24
  2110.  
  2111.           .long     globinits+32
  2112.  
  2113.           .long     globinits+40
  2114.  
  2115.           .long     globinits+48
  2116.  
  2117.           .long     globinits+56
  2118.  
  2119.           .long     globinits+64
  2120.  
  2121.           .long     globinits+72
  2122.  
  2123.           .long     globinits+80
  2124.  
  2125.           .long     globinits+88
  2126.  
  2127.           .long     globinits+96
  2128.  
  2129.           .long     globinits+104
  2130.  
  2131.           .long     globinits+112
  2132.  
  2133.           .long     globinits+120
  2134.  
  2135.           .long     globinits+128
  2136.  
  2137.           .long     globinits+136
  2138.  
  2139.           .long     globinits+144
  2140.  
  2141.           .long     globinits+152
  2142.  
  2143.           .long     globinits+160
  2144.  
  2145.           .long     globinits+168
  2146.  
  2147.           .long     globinits+176
  2148.  
  2149.           .long     globinits+184
  2150.  
  2151.           .long     globinits+192
  2152.  
  2153.           .long     globinits+200
  2154.  
  2155.           .long     globinits+208
  2156.  
  2157.           .long     globinits+216
  2158.  
  2159.           .long     globinits+224
  2160.  
  2161.           .long     globinits+232
  2162.  
  2163.           .long     globinits+240
  2164.  
  2165.           .long     globinits+248
  2166.  
  2167.           .long     Rgbval-4
  2168.  
  2169.           .long     UInstr-4
  2170.  
  2171.           .long     Prefab-4
  2172.  
  2173.           .long     Datab-4
  2174.  
  2175.           .long     Addexp-4
  2176.  
  2177.           .long     ErrorH-4
  2178.  
  2179.           .long     ErrorH+4
  2180.  
  2181.           .long     CallBH-4
  2182.  
  2183.           .long     CallBH+4
  2184.  
  2185.           .long     EventH-4
  2186.  
  2187.           .long     ExitH-4
  2188.  
  2189.           .long     ExcepReg-4
  2190.  
  2191.           .long     0x87654321
  2192.  
  2193.